home *** CD-ROM | disk | FTP | other *** search
/ AOL File Library: 12,000 to 12,999 / 12000.zip / AOLDLs / Programmieren [sonstige Sprachen] / Roulette (Quellcode) / ROULET.bas < prev   
Encoding:
BASIC Source File  |  2014-12-28  |  54.6 KB  |  1,866 lines
  1. '***************************************************************************
  2. '* ROULET.BAS                                                              *
  3. '* Roulette Computerspiel                                                  *
  4. '* Stand: 16.11.94                                                         *
  5. '***************************************************************************
  6.  
  7. 'Variable:  Zahl%       ausgespielte Roulettezahl ( 0....36 )
  8. '           Farbe$()    Array für die Farbangabe je Ziffer
  9. '           bank#       Kontostand der Bank
  10. '           sp1#        Kontostand von Spieler 1
  11. '           sp2#        Kontostand von Spieler 2
  12. '           cureins#    Summe der Einsätze auf dem Roulettetisch
  13. '           spieler1$   Name des ersten Spielers
  14. '           spieler2$   Name des zweiten Spielers
  15. '           num$        Hilfsstring für Zahleneingabe
  16. '           x1%         x-Koord. linke, obere Ecke des Setzfeldes bei Null
  17. '           y1%         y-Koord.  wie oben
  18. '           dx1%        Spaltenabstand des Setzfeldes
  19. '           dy1%        Zeilenabstand des Setzfeldes
  20. '           xb%         x-Koord. für Bilanzfeld
  21. '           yb%         y-Koord. für Bilanzfeld
  22. '           xch%        x-Koord. des 5 DM Chips
  23. '           ych%        y-Koord. des 5 DM Chips
  24. '           dxch%       x-Abstand der Chips
  25. '           dych%       y-Abstand der Chips
  26. '           rch%        Radius der Chips
  27. '           xf%         x-Koord. der ersten Funktionstaste
  28. '           yf%         y-Koord. der ersten Funktionstaste
  29. '           dxf%        Abstand der Funktionstasten in x
  30. '           lxf%        Funktionstastenlänge
  31. '           lyf%        Funktionstastenbreite
  32. '
  33.  
  34. TYPE Feld
  35.     x AS INTEGER
  36.     y AS INTEGER
  37.     dx AS INTEGER
  38.     dy AS INTEGER
  39.     m AS INTEGER
  40.     n AS INTEGER
  41. END TYPE
  42. '
  43. '       |              m * dx                     |
  44. '       |    dx    |                              |
  45. '   x,y +----------+----------+........+----------+---------
  46. '       |          |          |        |          |
  47. '       |  Feld1   |  Feld2   |        |  Feld(m) |  dy
  48. '       |          |          |        |          |
  49. '       +----------+----------+........+----------+-----
  50. '       |          |          |        |          |
  51. '       | Feld(m+1)| Feld(m+2)|        | Feld(2*m)|
  52. '       :          :          :        :          :      n * dy
  53. '       :          :          :        :          :
  54. '       +----------+----------+........+----------+
  55. '       |          |          |        |          |
  56. '       |Feld(n-1) |Feld(n-1) |        |Feld(m*n) |
  57. '       |    *m +1 |    *m +2 |        |          |
  58. '       +----------+----------+........+----------+----------
  59. '
  60.  
  61. TYPE einsatz
  62.     akt AS INTEGER      'Gültigkeitsflag, 0 = ungültig
  63.     geld AS DOUBLE      'Höhe des Einsatzes
  64.     w AS INTEGER        'gewähltes Feld oder gewählte Ziffer
  65. END TYPE
  66.  
  67. '
  68. 'Subprogramms
  69.  
  70. DECLARE SUB AusWert (Zahl%)
  71. DECLARE SUB EinsEintr (spnr%, i%, einsatz#, wahl%)
  72. DECLARE SUB FehlMeld (FehlNr%)
  73. DECLARE SUB Mouse (m1%, m2%, m3%, m4%)      'MOUSE.ASM aus MIXED.QLB
  74. DECLARE SUB MouseAction (xm1%, ym1%)
  75. DECLARE SUB MousePut (xMouse%, yMouse%)
  76. DECLARE SUB MouseHide ()
  77. DECLARE SUB MouseInches (horizontal%, vertical%)
  78. DECLARE SUB MouseInstall (mflag%)
  79. DECLARE SUB MousePressLeft (leftcount%, xMouse%, yMouse%)
  80. DECLARE SUB MouseReleaseLeft (leftcount%, xMouse%, yMouse%)
  81. DECLARE SUB MouseNow (leftButton%, rightButton%, xMouse%, yMouse%)
  82. DECLARE SUB MouseShow ()
  83. DECLARE SUB Setzen (spieler$, spnr%)
  84. DECLARE SUB Spielfeld ()
  85.  
  86.  
  87. 'Functions
  88.  
  89. DECLARE FUNCTION FEinsatz# (xk%, yk%)
  90. DECLARE FUNCTION FGameNew% ()
  91. DECLARE FUNCTION FTaste% (xk%, yk%)
  92. DECLARE FUNCTION FWahl$ (wahl%)
  93. DECLARE FUNCTION Infeld% (xk%, yk%, afeld AS Feld)
  94. DECLARE FUNCTION FGetWahl% (xk%, yk%)
  95.  
  96.  
  97. DIM SHARED chfeld AS Feld       'Chipfeld
  98. DIM SHARED ffeld AS Feld        'Funktionstastenfeld
  99. DIM SHARED sfeld AS Feld        'Spielendetastenfeld
  100. DIM SHARED zfeld AS Feld        'Rouletteziffernfeld
  101. DIM SHARED rsfeld AS Feld       'allgemeine Roulettefelder z.B. rot /schwarz
  102. DIM SHARED dfeld AS Feld        'Dutzend- und Spaltenfeldzeile
  103.  
  104. DIM SHARED x1%, y1%, dx1%, dy1%, xch%, ych%, dxch%, dych%, rch%
  105. DIM SHARED xf%, yf%, dxf%, lxf%, lyf%, xm1%, ym1%, sp1#, sp2#, cureins#
  106. DIM SHARED spieler2$
  107.  
  108. DIM SHARED chipfeld%(9000)              'Zwischenspeicher für Fenster
  109.  
  110. 'Array für Spieleinsätze mit Elementen vom Typ einsatz
  111. '1. Dimension für Spieler1 und Spieler2
  112. '2. Dimension für bis zu 3 Einsätze je Spieler
  113.  
  114. DIM SHARED speins(1 TO 2, 1 TO 3) AS einsatz
  115.  
  116. 'Array für Gewinn je Spieler
  117. DIM SHARED spgew(1 TO 2) AS DOUBLE
  118.  
  119. '
  120. DIM SHARED Farbe$(36)               'Farbangabe für 0 - 36
  121.  
  122. ' n = Null (keine Farbe)    r = rot     s = schwarz
  123. '0 - 9
  124. DATA n, r, s, r, s, r, s, r, s, r
  125.  
  126. '10 - 19
  127. DATA s, s, r, s, r, s, r, s, r, r
  128.  
  129. '20 - 29
  130. DATA s, r, s, r, s, r, s, r, s, s
  131.  
  132. '30 - 36
  133. DATA r, s, r, s, r, s, r
  134.  
  135. FOR i% = 0 TO 36                    'Werte in Array einlesen
  136.     READ Farbe$(i%)
  137. NEXT i%
  138.  
  139. '*********************** Programmbeginn *************************
  140.  
  141. SCREEN 12
  142. PALETTE 0, 7680     'Hintergrund grün
  143. COLOR 15
  144. CLS
  145. PRINT
  146. PRINT
  147. PRINT "    Willkommen zu Roulette! "
  148. PRINT "    Dieses Spiel befindet sich in Entwicklung, "
  149. PRINT "    deshalb übernimmt der Autor keine Haftung "
  150. PRINT "    für etwaig auftretende Probleme!"
  151. PRINT
  152. PRINT
  153. INPUT "    Name des ersten Spielers: ", spieler1$
  154. IF spieler1$ = "" THEN
  155.     spieler1$ = "Max"
  156.     spieler2$ = "Moritz"
  157.     bank# = 10000
  158.     sp1# = 5000
  159.     sp2# = 5000
  160. ELSE
  161.     INPUT "    Name des zweiten Spielers: ", spieler2$
  162.         INPUT "    Kontostand der Bank: ", num$
  163.         bank# = VAL(num$)
  164.         INPUT "    Kontostand von Spieler 1: ", num$
  165.         sp1# = VAL(num$)
  166.     IF spieler2$ <> "" THEN
  167.         INPUT "    Kontostand von Spieler 2: ", num$
  168.         sp2# = VAL(num$)
  169.     END IF
  170. END IF
  171.  
  172. '********************* Zufallsgenerator initialisieren ***************
  173.  
  174. RANDOMIZE TIMER
  175.  
  176. '*********************** Spielfeld erstellen *************************
  177.  
  178. CALL Spielfeld
  179. 'Chipbereich abspeichern
  180. GET (0, 290)-(230, 444), chipfeld%(0)
  181.  
  182. '*********************** Mouse-Installation **************************
  183.  
  184. MouseInstall mflag%
  185. IF mflag% = 0 THEN
  186.     PRINT "Keine Maus installiert!"
  187.     SYSTEM
  188. END IF
  189.  
  190. '******************** Spielstand anzeigen ****************************
  191.  
  192. GOSUB Kontoanzeige
  193.  
  194. '******************* Hier beginnt jede neue Ausspielung *******************
  195.  
  196. DO
  197.     MouseHide
  198.     PUT (0, 290), chipfeld%(0), PSET
  199.     MouseShow
  200.     COLOR 14
  201.     LOCATE 12, 1
  202.     FOR i% = 1 TO 21
  203.         PRINT SPACE$(30)
  204.     NEXT i%
  205.     LOCATE 12, 1
  206.  
  207. '*********************** Eingabe der Spieleinsätze *************************
  208.  
  209.     'Spieleinsätze auf nicht aktuell setzen
  210.     speins(1, 1).akt = 0
  211.     speins(1, 2).akt = 0
  212.     speins(1, 3).akt = 0
  213.     speins(2, 1).akt = 0
  214.     speins(2, 2).akt = 0
  215.     speins(2, 3).akt = 0
  216.     cureins# = 0
  217.     
  218.     'neuen Einsatz abfragen für spieler1
  219.     spnr% = 1
  220.     Setzen spieler1$, spnr%
  221.     'Ausgabe des neuen Kontostands für Spieler1
  222.     GOSUB Kontoanzeige
  223.  
  224.     IF spieler2$ <> "" THEN
  225.         spnr% = 2
  226.         'neuen Einsatz abfragen für spieler2
  227.         Setzen spieler2$, spnr%
  228.         'Ausgabe des neuen Kontostands für Spieler2
  229.         GOSUB Kontoanzeige
  230.     END IF
  231.    
  232. '************************** Ausspielung ************************************
  233.  
  234.     MouseHide
  235.     PUT (0, 290), chipfeld%(0), XOR
  236.     MouseShow
  237.    
  238.     SLEEP 3
  239.  
  240.     Zahl% = INT(37 * RND)
  241.     COLOR 15
  242.     LOCATE 40, 1
  243.     IF Farbe$(Zahl%) = "r" THEN
  244.         PRINT "Ausspielung: "; Zahl%; " ";
  245.         COLOR 12
  246.         PRINT "rot"
  247.         COLOR 15
  248.     ELSEIF Farbe$(Zahl%) = "s" THEN
  249.         PRINT "Ausspielung: "; Zahl%; " ";
  250.         COLOR 8
  251.         PRINT "schwarz"
  252.         COLOR 15
  253.     ELSE
  254.         PRINT "Ausspielung: "; Zahl%
  255.     END IF
  256.  
  257. '********************** Auswertung des Spieles ****************************
  258.   
  259.     AusWert Zahl%
  260.     PRINT
  261.     PRINT
  262.     PRINT "Die Bank zahlt an"
  263.     PRINT
  264.     PRINT spieler1$, "DM";
  265.     PRINT USING "#####.##"; spgew(1)
  266.     PRINT
  267.     IF spieler2$ <> "" THEN
  268.         PRINT spieler2$, "DM";
  269.         PRINT USING "#####.##"; spgew(2)
  270.     END IF
  271.     'Bankergebnis ermitteln
  272.     PRINT
  273.     PRINT
  274.     cureins# = cureins# - spgew(1) - spgew(2)
  275.     IF cureins# < 0 THEN
  276.         PRINT "Die Bank verliert DM";
  277.     ELSE
  278.         PRINT "Die Bank gewinnt DM";
  279.     END IF
  280.     PRINT USING "######.##"; ABS(cureins#)
  281.  
  282.     'Neue Kontostände ermitteln
  283.  
  284.     bank# = bank# + cureins#
  285.     IF bank# < 0 THEN
  286.         PRINT
  287.         PRINT "Die Bank ist Pleite !!!"
  288.         FOR n% = 1 TO 3
  289.             BEEP
  290.         NEXT n%
  291.     END IF
  292.    
  293.     sp1# = sp1# + spgew(1)
  294.     sp2# = sp2# + spgew(2)
  295.    
  296.     GOSUB Kontoanzeige
  297.    
  298. '********************** Spielende / Neues Spiel ***************************
  299.     
  300. LOOP UNTIL FGameNew% = 1
  301.  
  302. END
  303.  
  304. '********************** Subroutine: Kontoanzeige **************************
  305.  
  306. Kontoanzeige:
  307.     xb% = 1
  308.     yb% = 4
  309.     COLOR 15
  310.     LINE (xb%, yb%)-(xb% + 200, yb% + 60), 13, B
  311.    
  312.     'Retten der Einstellungen für Textausgabe
  313.     curlin% = CSRLIN: curspa% = POS(0)
  314.    
  315.     LOCATE 1, 8
  316.     PRINT "Spielstand"
  317.     LOCATE 3, 3
  318.     PRINT "Bank",
  319.     PRINT USING "#######.##"; bank#
  320.     LOCATE 5, 3
  321.     PRINT spieler1$,
  322.     PRINT USING "#######.##"; sp1#
  323.     IF spieler2$ <> "" THEN
  324.         LOCATE 7, 3
  325.         PRINT spieler2$,
  326.         PRINT USING "#######.##"; sp2#
  327.     END IF
  328.    
  329.     'Wiederherstellen der Einstellungen für Textausgabe
  330.     LOCATE curlin%, curspa%
  331. RETURN
  332.  
  333. '***************************************************************************
  334. '* AusWert                                                                 *
  335. '* Subprogramm zur Auswertung des Spielergebnisses                         *
  336. '* Stand: 16.11.94                                                         *
  337. '***************************************************************************
  338. '
  339. 'Wertet das Spielergebnis aus und ermittelt die etwaigen Gewinne bei
  340. 'einfachen Einsätzen wie, z.B rot, passe, pair, dutzend, spalte etc.
  341. '
  342. 'Aufruf durch:      ROULET.BAS
  343. '
  344. 'Ruft auf:          -
  345. '
  346. '
  347. 'Übergabeparameter:     Zahl%       ausgespielte Roulettezahl
  348. '
  349. SUB AusWert (Zahl%)
  350.  
  351. 'Löschen der aus der ausgespielten Zahl des vorherigen Spiels ermittelten
  352. 'einfachen Gewinnfelder
  353.  
  354. gfarbe% = 0
  355. gcase% = 0
  356. ghoch% = 0
  357. gdutz% = 0
  358. gspalt% = 0
  359.  
  360. '********************* Allgemeine Setzfelder ***************************
  361. 'Farbe ermittlen für alle Zahlen außer null
  362.  
  363. IF Zahl% THEN           'Nicht erfüllt bei null
  364.     IF Farbe$(Zahl%) = "r" THEN
  365.         gfarbe% = 713       'rot
  366.     ELSE
  367.         gfarbe% = 703       'schwarz
  368.     END IF
  369.  
  370. 'Gerade oder ungerade Zahl ermitteln außer für null
  371.  
  372.     IF Zahl% MOD 2 THEN
  373.         gcase% = 712        'ungerade
  374.     ELSE
  375.         gcase% = 702        'gerade
  376.     END IF
  377.  
  378. 'Hohe oder niedrige Zahl ermitteln außer für null
  379.  
  380.     IF Zahl% > 18 THEN
  381.         ghoch% = 701        '19 - 36
  382.     ELSE
  383.         ghoch% = 711        ' 1 - 18
  384.     END IF
  385.  
  386. 'Dutzend ermitteln außer für null
  387.  
  388.     IF Zahl% < 13 THEN
  389.         gdutz% = 601        ' 1 - 12
  390.     ELSEIF Zahl% > 24 THEN
  391.         gdutz% = 603        '25 - 36
  392.     ELSE
  393.         gdutz% = 602        '13 - 24
  394.     END IF
  395.  
  396. 'Spalte ermitteln außer für null
  397.  
  398.     SELECT CASE Zahl%
  399.         CASE 1, 4, 7, 10, 13, 16, 19, 22, 25, 28, 31, 34
  400.             gspalt% = 611       '1. Spalte
  401.         CASE 2, 5, 8, 11, 14, 17, 20, 23, 26, 29, 32, 35
  402.             gspalt% = 612       '2. Spalte
  403.         CASE ELSE
  404.             gspalt% = 613       '3. Spalte
  405.     END SELECT
  406. END IF
  407.  
  408. '************************ Zahlen ****************************************
  409. 'Initialisierung
  410.  
  411. CONST na% = -1
  412. gz1% = na%
  413. gz21% = na%
  414. gz22% = na%
  415. gz23% = na%
  416. gz24% = na%
  417. gz31% = na%
  418. gz32% = na%
  419. gz33% = na%
  420. gz34% = na%
  421. gz41% = na%
  422. gz42% = na%
  423. gz43% = na%
  424. gz44% = na%
  425. gz61% = na%
  426. gz62% = na%
  427. gz63% = na%
  428. gz64% = na%
  429.  
  430. SELECT CASE Zahl%
  431.     CASE 0
  432.         gz1% = 0
  433.         gz21% = 2
  434.         gz22% = 4
  435.         gz23% = 6
  436.         gz31% = 3
  437.         gz32% = 5
  438.         gz41% = 1
  439.         gz42% = 7
  440.     CASE 1
  441.         gz1% = 9
  442.         gz21% = 10
  443.         gz22% = 16
  444.         gz23% = 2
  445.         gz31% = 8
  446.         gz32% = 14
  447.         gz33% = 3
  448.         gz41% = 17
  449.         gz61% = 15
  450.         gz62% = 21
  451.     CASE 2
  452.         gz1% = 11
  453.         gz21% = 4
  454.         gz22% = 10
  455.         gz23% = 12
  456.         gz24% = 18
  457.         gz31% = 8
  458.         gz32% = 14
  459.         gz33% = 3
  460.         gz34% = 5
  461.         gz41% = 17
  462.         gz42% = 19
  463.         gz61% = 15
  464.         gz62% = 21
  465.     CASE 3
  466.         gz1% = 13
  467.         gz21% = 6
  468.         gz22% = 20
  469.         gz23% = 12
  470.         gz31% = 8
  471.         gz32% = 14
  472.         gz33% = 5
  473.         gz41% = 19
  474.         gz61% = 15
  475.         gz62% = 21
  476.     CASE 4, 7, 10, 13, 16, 19, 22, 25, 28, 31
  477.         n% = (Zahl% - 4) \ 3
  478.         gz1% = 23 + n% * 14
  479.         gz21% = 16 + n% * 14
  480.         gz22% = 24 + n% * 14
  481.         gz23% = 30 + n% * 14
  482.         gz31% = 22 + n% * 14
  483.         gz32% = 28 + n% * 14
  484.         gz41% = 17 + n% * 14
  485.         gz42% = 31 + n% * 14
  486.         gz61% = 15 + n% * 14
  487.         gz62% = 21 + n% * 14
  488.         gz63% = 29 + n% * 14
  489.         gz64% = 35 + n% * 14
  490.     CASE 5, 8, 11, 14, 17, 20, 23, 26, 29, 32
  491.         n% = (Zahl% - 5) \ 3
  492.         gz1% = 25 + n% * 14
  493.         gz21% = 18 + n% * 14
  494.         gz22% = 24 + n% * 14
  495.         gz23% = 26 + n% * 14
  496.         gz24% = 32 + n% * 14
  497.         gz31% = 22 + n% * 14
  498.         gz32% = 28 + n% * 14
  499.         gz41% = 17 + n% * 14
  500.         gz42% = 19 + n% * 14
  501.         gz43% = 31 + n% * 14
  502.         gz44% = 33 + n% * 14
  503.         gz61% = 15 + n% * 14
  504.         gz62% = 21 + n% * 14
  505.         gz63% = 29 + n% * 14
  506.         gz64% = 35 + n% * 14
  507.     CASE 6, 9, 12, 15, 18, 21, 24, 27, 30, 33
  508.         n% = (Zahl% - 6) \ 3
  509.         gz1% = 27 + n% * 14
  510.         gz21% = 20 + n% * 14
  511.         gz22% = 26 + n% * 14
  512.         gz23% = 34 + n% * 14
  513.         gz31% = 22 + n% * 14
  514.         gz32% = 28 + n% * 14
  515.         gz41% = 19 + n% * 14
  516.         gz42% = 33 + n% * 14
  517.         gz61% = 15 + n% * 14
  518.         gz62% = 21 + n% * 14
  519.         gz63% = 29 + n% * 14
  520.         gz64% = 35 + n% * 14
  521.     CASE 34
  522.         gz1% = 163
  523.         gz21% = 156
  524.         gz22% = 164
  525.         gz31% = 162
  526.         gz32% = 168
  527.         gz41% = 157
  528.         gz61% = 155
  529.         gz62% = 161
  530.     CASE 35
  531.         gz1% = 165
  532.         gz21% = 164
  533.         gz22% = 158
  534.         gz23% = 166
  535.         gz31% = 162
  536.         gz32% = 168
  537.         gz41% = 157
  538.         gz42% = 159
  539.         gz61% = 155
  540.         gz62% = 161
  541.     CASE 36
  542.         gz1% = 167
  543.         gz21% = 166
  544.         gz22% = 160
  545.         gz31% = 162
  546.         gz32% = 168
  547.         gz41% = 159
  548.         gz61% = 155
  549.         gz62% = 161
  550.     CASE ELSE
  551.         FehlMeld 4      'Zahl% < 0 oder Zahl% > 36
  552.     END SELECT
  553.  
  554.  
  555. '**************** Ermittlung der Spielergebnisse *************************
  556.  
  557. FOR s% = 1 TO 2         'Für Spieler1 und Spieler2
  558.     spgew(s%) = 0       'löschen des alten Gewinnes
  559.  
  560.     FOR i% = 1 TO 3     'Für Einsatz1 bis Einsatz3
  561.         IF speins(s%, i%).akt THEN  'für gültigen Spieleinsatz
  562.            
  563.             SELECT CASE speins(s%, i%).w
  564.                 CASE gfarbe%, gcase%, ghoch%
  565.                     gewfac# = 2
  566.                 CASE gdutz%, gspalt%
  567.                     gewfac# = 3
  568.                 CASE gz61%, gz62%, gz63%, gz64%
  569.                     gewfac# = 6
  570.                 CASE gz41%, gz42%, gz43%, gz44%
  571.                     gewfac# = 9
  572.                 CASE gz31%, gz32%, gz33%, gz34%
  573.                     gewfac# = 12
  574.                 CASE gz21%, gz22%, gz23%, gz24%
  575.                     gewfac# = 18
  576.                 CASE gz1%
  577.                     gewfac# = 36
  578.                 CASE ELSE
  579.                     gewfac# = 0
  580.             END SELECT
  581.  
  582. 'Sonderbehandlung bei Roulettezahl = 0       
  583.             IF Zahl% = 0 THEN
  584.                 IF speins(s%, i%).akt THEN  'für gültigen Spieleinsatz
  585.                     IF speins(s%, i%).w > 700 AND speins(s%, i%).w < 714 THEN
  586.                         gewfac# = .5
  587.                     END IF
  588.                 END IF
  589.             END IF
  590.             spgew(s%) = spgew(s%) + speins(s%, i%).geld * gewfac#
  591.         END IF
  592.     NEXT i%
  593. IF spieler2$ = "" THEN EXIT FOR     'Exit, wenn nur 1 Spieler
  594. NEXT s%
  595.  
  596. END SUB
  597.  
  598. '***************************************************************************
  599. '* EinsEintr                                                               *
  600. '* Subprogramm zum Eintragen des Einsatzes ins Typenfeld                   *
  601. '* Stand: 06.11.94                                                         *
  602. '***************************************************************************
  603. '
  604. 'Trägt den Einsatz und die gewählte Ziffer etc. für den jeweiligen Spieler
  605. 'in das Typfeld Einsatz ein
  606. '
  607. 'Aufruf durch:  Setzen
  608. '
  609. 'Ruft auf:      -
  610. '
  611. 'Parameters:    s%          Spielernummer
  612. '               i%          Wievielter Einsatz ( 1....3 )
  613. '               einsatz#    Betrag des eingesetzten Geldes
  614. '               wahl%       Feldnummer des gesetzten Feldes
  615. '
  616. SUB EinsEintr (s%, i%, einsatz#, wahl%)
  617.  
  618.     IF s% = 1 OR s% = 2 THEN
  619.         IF i% >= 1 AND i% <= 3 THEN
  620.             speins(s%, i%).akt = 1
  621.             speins(s%, i%).geld = einsatz#
  622.             speins(s%, i%).w = wahl%
  623.         END IF
  624.     END IF
  625.  
  626. END SUB
  627.  
  628. '***************************************************************************
  629. '* FehlMeld                                                                *
  630. '* Subprogramm zur Ausgabe einer Fehlernachricht                           *
  631. '* Stand: 18.09.94                                                         *
  632. '***************************************************************************
  633. '
  634. 'Ausgabe einer Fehlermeldung in einer Box am Bildschirm
  635. '
  636. 'Aufruf durch:      Setzen, AusWert
  637. '
  638. 'Ruft auf:          MouseHide, MouseShow
  639. '
  640. 'Parameters:       FehlNr%         Fehlernummer
  641. '
  642. SUB FehlMeld (FehlNr%)
  643.  
  644. 'Löschen des Chipfelds für Fehlerbox
  645. MouseHide
  646. PUT (0, 290), chipfeld%(0), XOR
  647. xb% = 1
  648. yb% = 300
  649. LINE (xb%, yb%)-(xb% + 228, yb% + 76), 12, B
  650. LINE (xb% + 2, yb% + 2)-(xb% + 226, yb% + 74), 12, B
  651. COLOR 15
  652. bzeile% = 40: bspalte% = 3
  653. LOCATE bzeile%, bspalte%
  654. SELECT CASE FehlNr%
  655. CASE 1
  656.     PRINT "Falscheingabe bei Chipwahl"
  657.     PRINT
  658. CASE 2
  659.     PRINT "Falscheingabe bei Feldwahl"
  660.     PRINT
  661. CASE 3
  662.     PRINT "Kontoüberziehung !!!"
  663.     PRINT
  664. CASE 4
  665.     PRINT "Auswertung mit Zahl%"
  666.     PRINT "außerhalb des Bereichs"
  667. CASE ELSE
  668.     PRINT "Aufruf von FehlMeld mit"
  669.     LOCATE , bspalte%
  670.     PRINT "   unbekannter Fehlernummer!"
  671. END SELECT
  672. PRINT
  673. LOCATE , bspalte% + 4
  674. PRINT "Bestätigung "
  675. LOCATE , bspalte%
  676. PRINT "mit beliebiger Taste"
  677. MouseShow
  678.  
  679. 'Warten auf Bestätigung durch Tastendruck
  680. DO
  681.     ky$ = INKEY$
  682. LOOP UNTIL LEN(ky$)
  683.  
  684. 'Chipfeld wiederherstellen
  685. MouseHide
  686. PUT (0, 290), chipfeld%(0), PSET
  687. MouseShow
  688. COLOR 14
  689. END SUB
  690.  
  691. '***************************************************************************
  692. '* FEinsatz#                                                               *
  693. '* Function zur Ermittlung des Spieleinsatzes                              *
  694. '* Stand: 09.07.94                                                         *
  695. '***************************************************************************
  696. '
  697. 'Ergebnis des Funktionsaufrufs: Höhe des Geldeinsatzes
  698. '                               oder Null im Falle eines Falschaufrufes
  699. '
  700. 'Aufruf durch:      Setzen
  701. '
  702. 'Ruft auf:          Infeld
  703. '
  704. 'Parameters:    xm1%, ym1%      Mauskoordinaten
  705. '
  706. FUNCTION FEinsatz# (xm1%, ym1%)
  707.  
  708. 'Test ob ausserhalb des Bereiches der Chipfelder
  709.  
  710. m% = 4
  711. n% = 2
  712.  
  713. IF xm1% < xch% - rch% OR xm1% > xch% - rch% + m% * dxch% THEN
  714.     FEinsatz# = 0
  715.     EXIT FUNCTION
  716. ELSE
  717.     IF ym1% < ych% - rch% OR ym1% > ych% - rch% + n% * dych% THEN
  718.         FEinsatz# = 0
  719.         EXIT FUNCTION
  720.     END IF
  721. END IF
  722.  
  723. 'Übergabeparameter vorbereiten
  724.  
  725. chfeld.x = xch% - rch%
  726. chfeld.y = ych% - rch%
  727. chfeld.dx = dxch%
  728. chfeld.dy = dych%
  729. chfeld.m = 4
  730. chfeld.n = 2
  731.  
  732. FeldNr% = Infeld%(xm1%, ym1%, chfeld)
  733.  
  734. SELECT CASE FeldNr%
  735.     CASE 1
  736.         FEinsatz# = 5
  737.     CASE 2
  738.         FEinsatz# = 10
  739.     CASE 3
  740.         FEinsatz# = 20
  741.     CASE 4
  742.         FEinsatz# = 50
  743.     CASE 5
  744.         FEinsatz# = 100
  745.     CASE 6
  746.         FEinsatz# = 200
  747.     CASE 7
  748.         FEinsatz# = 500
  749.     CASE 8
  750.         FEinsatz# = 1000
  751.     CASE ELSE
  752.         PRINT "Fehler bei Auswahl der Chips!"
  753.         FEinsatz# = 0
  754. END SELECT
  755.  
  756. END FUNCTION
  757.  
  758. '***************************************************************************
  759. '* FGameNew%                                                               *
  760. '* Function zur Ermittlung ob neues Spiel oder Ende                        *
  761. '* Stand: 19.10.94                                                         *
  762. '***************************************************************************
  763. '
  764. 'Ergebnis des Funktionsaufrufs: 1 = Spielende
  765. '                               2 = Neues Spiel
  766. '
  767. 'Aufruf durch:      ROULET.BAS
  768. '
  769. 'Ruft auf:          Infeld, MouseHide, MouseShow
  770. '
  771. '
  772. 'Variables:     xs%         x-Koord. der ersten Spielendetaste
  773. '               ys%         y-Koord. der ersten Spielendetaste
  774. '               dxs%        Abstand der Funktionstasten in x
  775. '               lxs%        Funktionstastenlänge
  776. '               lys%        Funktionstastenbreite
  777. '
  778. '
  779. FUNCTION FGameNew%
  780.  
  781. '******************** Tasten zeichnen ************************************
  782.  
  783. xs% = 6
  784. ys% = 412
  785. dxs% = 120
  786. lxs% = 100
  787. lys% = 30
  788. PALETTE 7, 2555959
  789. MouseHide
  790. FOR i% = 0 TO 1
  791.     LINE (xs% + i% * dxs%, ys%)-(xs% + lxs% + i% * dxs%, ys% + lys%), 15, B
  792.     PAINT (xs% + lxs% / 2 + i% * dxs%, ys% + lys% / 2), 7, 15
  793. NEXT i%
  794.  
  795. COLOR 15
  796. LOCATE 54, 3
  797. PRINT "Spielende"
  798. LOCATE 54, 18
  799. PRINT "Neues Spiel"
  800. MouseShow
  801. '********************* Auswertung der gewählten Taste *********************
  802.  
  803. DO
  804.     MouseAction xm1%, ym1%
  805.     'Abfrage ob innerhalb Spielendetastenfeld
  806.     flag% = 1
  807.     IF xm1% < xs% OR xm1% > xs% + dxs% + lxs% THEN
  808.         flag% = 0
  809.     ELSE
  810.         IF ym1% < ys% OR ym1% > ys% + lys% THEN
  811.             flag% = 0
  812.         END IF
  813.     END IF
  814. LOOP UNTIL flag% <> 0
  815.  
  816. 'Übergabeparameter vorbereiten
  817. sfeld.x = xs%
  818. sfeld.y = ys%
  819. sfeld.dx = dxs%
  820. sfeld.dy = lys%
  821. sfeld.m = 2
  822. sfeld.n = 1
  823.  
  824. FGameNew% = Infeld%(xm1%, ym1%, sfeld)
  825.  
  826. END FUNCTION
  827.  
  828. '***************************************************************************
  829. '* FGetWahl%                                                               *
  830. '* Function zur Ermittlung der symbolischen Feldnummer des gewählten Felds *
  831. '* Stand: 31.10.94                                                         *
  832. '***************************************************************************
  833. '
  834. 'Ergebnis des Funktionsaufrufs: symbolische Feldnummer des gewählten Felds
  835. '                               bei Falscheingabe 888!
  836. '
  837. 'Aufruf durch:      Setzen
  838. '
  839. 'Ruft auf:          Infeld, ZifWahl
  840. '
  841. 'Parameters:    xm1%, ym1%      Mauskoordinaten
  842. '
  843. FUNCTION FGetWahl% (xm1%, ym1%)
  844.  
  845. 'Überprüfung ob im Roulettefeldbereich
  846.  
  847. IF xm1% < x1% - 3 * dx1% OR xm1% > x1% + 6 * dx1% THEN
  848.     FGetWahl% = 888
  849.     EXIT FUNCTION
  850. END IF
  851. IF ym1% < y1% OR ym1% > y1% + 14 * dy1% THEN
  852.     FGetWahl% = 888
  853.     EXIT FUNCTION
  854. END IF
  855. IF ym1% > y1% AND ym1% < y1% + dy1% THEN
  856.     IF xm1% < x1% OR xm1% > x1% + 3 * dx1% THEN
  857.         'obere Ecken links und rechts von Null
  858.         FGetWahl% = 888
  859.         EXIT FUNCTION
  860.     END IF
  861. END IF
  862.  
  863. 'Ermittlung ob unterste Zeile ( Dutzendfelder und Spalten )
  864.  
  865. IF ym1% > y1% + 13 * dy1% AND ym1% < y1% + 14 * dy1% THEN
  866.     IF xm1% > x1% - 3 * dx1% AND xm1% < x1% + 6 * dx1% THEN
  867.         '******** unterste Zeile der Setzfelder
  868.         dfeld.x = x1% - 3 * dx1%
  869.         dfeld.y = y1% + 13 * dy1%
  870.         dfeld.dx = dx1%
  871.         dfeld.dy = dy1%
  872.         dfeld.m = 9
  873.         dfeld.n = 1
  874.         FeldNr% = Infeld%(xm1%, ym1%, dfeld)
  875.         SELECT CASE FeldNr%
  876.             CASE 1 TO 3
  877.                 FGetWahl% = FeldNr% + 600   'linke Dutzendfelder
  878.             CASE 4 TO 6
  879.                 FGetWahl% = FeldNr% + 607   'Spalten (611 bis 613)
  880.             CASE 7 TO 9
  881.                 FGetWahl% = 610 - FeldNr%   'rechte Dutzendfelder
  882.             CASE ELSE
  883.                 FGetWahl% = 888             'Fehler bei Feldwahl
  884.         END SELECT
  885.         EXIT FUNCTION
  886.     END IF
  887. END IF
  888.  
  889. 'Ermittlung ob allg. Feld oder im Ziffernbereich
  890.  
  891. IF xm1% > x1% - 3 * dx1% AND xm1% < x1% - dx1% / 4 THEN
  892.     '******* linke Spalte der allg. Felder
  893.     IF ym1% > y1% + dy1% AND ym1% < y1% + 13 * dy1% THEN
  894.         rsfeld.x = x1% - 3 * dx1%
  895.         rsfeld.y = y1% + dy1%
  896.         rsfeld.dx = 3 * dx1%
  897.         rsfeld.dy = 4 * dy1%
  898.         rsfeld.m = 1
  899.         rsfeld.n = 3
  900.     FeldNr% = Infeld%(xm1%, ym1%, rsfeld)
  901.     FGetWahl% = FeldNr% + 700
  902.     EXIT FUNCTION
  903.     END IF
  904. END IF
  905.  
  906. IF xm1% > x1% + 3 * dx1% + dx1% / 4 AND xm1% < x1% + 6 * dx1% THEN
  907.     '******* rechte Spalte der allg. Felder
  908.     IF ym1% > y1% + dy1% AND ym1% < y1% + 13 * dy1% THEN
  909.         rsfeld.x = x1% + 3 * dx1%
  910.         rsfeld.y = y1% + dy1%
  911.         rsfeld.dx = 3 * dx1%
  912.         rsfeld.dy = 4 * dy1%
  913.         rsfeld.m = 1
  914.         rsfeld.n = 3
  915.     FeldNr% = Infeld%(xm1%, ym1%, rsfeld)
  916.     FGetWahl% = FeldNr% + 710
  917.     EXIT FUNCTION
  918.     END IF
  919. END IF
  920.  
  921. 'Abfrage ob Null
  922.  
  923. IF ym1% > y1% AND ym1% < y1% + dy1% - dy1% / 4 THEN
  924.     IF xm1% > x1% AND xm1% < x1% + 3 * dx1% THEN
  925.         '********** Null wurde gewählt
  926.         FGetWahl% = 0
  927.         EXIT FUNCTION
  928.     END IF
  929. END IF
  930.  
  931. 'Übergabeparameter für Ziffernbereich vorbereiten
  932.  
  933. zfeld.x = x1% - dx1% / 4
  934. zfeld.y = y1% + dy1% - dy1% / 4
  935. zfeld.dx = dx1% / 2
  936. zfeld.dy = dy1% / 2
  937. zfeld.m = 7
  938. zfeld.n = 24
  939.  
  940. FGetWahl% = Infeld%(xm1%, ym1%, zfeld)
  941.  
  942. END FUNCTION
  943.  
  944. '***************************************************************************
  945. '* FTaste%                                                                 *
  946. '* Function zur Ermittlung der gewählten Funktionstaste                    *
  947. '* Stand: 23.06.94                                                         *
  948. '***************************************************************************
  949. '
  950. 'Ergebnis des Funktionsaufrufs: Nummer der gewählten Taste
  951. '                               1 = LÖSCHEN
  952. '                               2 = O.K.
  953. '                               3 = FERTIG
  954. '                               0 = keine Funktionstaste gedrückt
  955. '
  956. '
  957. 'Aufruf durch:      Setzen
  958. '
  959. 'Ruft auf:          Infeld
  960. '
  961. 'Parameters:    xm1%, ym1%      Mauskoordinaten
  962. '
  963. 'Variables:     xf%         x-Koord. der ersten Funktionstaste
  964. '               yf%         y-Koord. der ersten Funktionstaste
  965. '               dxf%        Abstand der Funktionstasten in x
  966. '               lxf%        Funktionstastenlänge
  967. '               lyf%        Funktionstastenbreite
  968. '               m%          Anzahl der Funktionstasten
  969. '
  970. FUNCTION FTaste% (xm1%, ym1%)
  971.  
  972. m% = 3
  973. IF xm1% < xf% OR xm1% > xf% + m% * dxf% THEN
  974.     FTaste% = 0
  975.     EXIT FUNCTION
  976. ELSE
  977.     IF ym1% < yf% OR ym1% > yf% + lyf% THEN
  978.         FTaste% = 0
  979.         EXIT FUNCTION
  980.     END IF
  981. END IF
  982.  
  983. 'Übergabeparameter vorbereiten
  984.  
  985. ffeld.x = xf%
  986. ffeld.y = yf%
  987. ffeld.dx = dxf%
  988. ffeld.dy = lyf%
  989. ffeld.m = 3
  990. ffeld.n = 1
  991.  
  992. FTaste% = Infeld%(xm1%, ym1%, ffeld)
  993.  
  994. END FUNCTION
  995.  
  996. '***************************************************************************
  997. '* FWahl$                                                                  *
  998. '* Function zur Ermittlung des Textes des Setzfeldes                       *
  999. '* Stand: 31.10.94                                                         *
  1000. '***************************************************************************
  1001. '
  1002. 'Ermittelt aus der symbolischen Feldnummer den Text für die Anzeige
  1003. 'und gibt diesen als String zurück
  1004. '
  1005. 'Aufruf durch:      Setzen
  1006. '
  1007. 'Ruft auf:          -
  1008. '
  1009. 'Parameters:   wahl%       symbolische Feldnummer
  1010. '
  1011. FUNCTION FWahl$ (wahl%)
  1012.  
  1013. SELECT CASE wahl%
  1014.     CASE IS > 700
  1015.         SELECT CASE wahl%
  1016.             CASE 701
  1017.                 FWahl$ = "PASSE"
  1018.             CASE 702
  1019.                 FWahl$ = "PAIR"
  1020.             CASE 703
  1021.                 FWahl$ = "NOIR"
  1022.             CASE 711
  1023.                 FWahl$ = "MANQUE"
  1024.             CASE 712
  1025.                 FWahl$ = "IMPAIR"
  1026.             CASE 713
  1027.                 FWahl$ = "ROUGE"
  1028.             CASE ELSE
  1029.                 PRINT "Unbekannte Wahl "; wahl%
  1030.         END SELECT
  1031.     CASE IS > 600
  1032.         SELECT CASE wahl%
  1033.             CASE 601
  1034.                 FWahl$ = "1 - 12"
  1035.             CASE 602
  1036.                 FWahl$ = "13 - 24"
  1037.             CASE 603
  1038.                 FWahl$ = "25 - 36"
  1039.             CASE 611
  1040.                 FWahl$ = "1.Spalte"
  1041.             CASE 612
  1042.                 FWahl$ = "2.Spalte"
  1043.             CASE 613
  1044.                 FWahl$ = "3.Spalte"
  1045.             CASE ELSE
  1046.                 PRINT "Unbekannte Wahl "; wahl%
  1047.         END SELECT
  1048.     CASE IS < 169
  1049.         SELECT CASE wahl%
  1050.             CASE 0: FWahl$ = "0"
  1051.             CASE 1, 7
  1052.                 FWahl$ = "0, 1, 2, 3"
  1053.             CASE 2: FWahl$ = "0, 1"
  1054.             CASE 3: FWahl$ = "0, 1, 2"
  1055.             CASE 4: FWahl$ = "0, 2"
  1056.             CASE 5: FWahl$ = "0, 2, 3"
  1057.             CASE 6: FWahl$ = "0, 3"
  1058.             CASE 8, 14
  1059.                 FWahl$ = "1, 2, 3"
  1060.             CASE 9: FWahl$ = "1"
  1061.             CASE 10: FWahl$ = "1, 2"
  1062.             CASE 11: FWahl$ = "2"
  1063.             CASE 12: FWahl$ = "2, 3"
  1064.             CASE 13: FWahl$ = "3"
  1065.             CASE 15, 21
  1066.                 FWahl$ = "1 - 6"
  1067.             CASE 16: FWahl$ = "1, 4"
  1068.             CASE 17: FWahl$ = "1, 2, 4, 5"
  1069.             CASE 18: FWahl$ = "2, 5"
  1070.             CASE 19: FWahl$ = "2, 3, 5, 6"
  1071.             CASE 20: FWahl$ = "3, 6"
  1072.             CASE 22, 28
  1073.                 FWahl$ = "4, 5, 6"
  1074.             CASE 23: FWahl$ = "4"
  1075.             CASE 24: FWahl$ = "4, 5"
  1076.             CASE 25: FWahl$ = "5"
  1077.             CASE 26: FWahl$ = "5, 6"
  1078.             CASE 27: FWahl$ = "6"
  1079.             CASE 29, 35
  1080.                 FWahl$ = "4 - 9"
  1081.             CASE 30: FWahl$ = "4, 7"
  1082.             CASE 31: FWahl$ = "4, 5, 7, 8"
  1083.             CASE 32: FWahl$ = "5, 8"
  1084.             CASE 33: FWahl$ = "5, 6, 8, 9"
  1085.             CASE 34: FWahl$ = "6, 9"
  1086.             CASE 36, 42
  1087.                 FWahl$ = "7, 8, 9"
  1088.             CASE 37: FWahl$ = "7"
  1089.             CASE 38: FWahl$ = "7, 8"
  1090.             CASE 39: FWahl$ = "8"
  1091.             CASE 40: FWahl$ = "8, 9"
  1092.             CASE 41: FWahl$ = "9"
  1093.             CASE 43, 49
  1094.                 FWahl$ = "7 - 12"
  1095.             CASE 44: FWahl$ = "7, 10"
  1096.             CASE 45: FWahl$ = "7, 8, 10, 11"
  1097.             CASE 46: FWahl$ = "8, 11"
  1098.             CASE 47: FWahl$ = "8, 9, 11, 12"
  1099.             CASE 48: FWahl$ = "9, 12"
  1100.             CASE 50, 56
  1101.                 FWahl$ = "10, 11, 12"
  1102.             CASE 51: FWahl$ = "10"
  1103.             CASE 52: FWahl$ = "10, 11"
  1104.             CASE 53: FWahl$ = "11"
  1105.             CASE 54: FWahl$ = "11, 12"
  1106.             CASE 55: FWahl$ = "12"
  1107.             CASE 57, 63
  1108.                 FWahl$ = "10 - 15"
  1109.             CASE 58: FWahl$ = "10, 13"
  1110.             CASE 59: FWahl$ = "10, 11, 13, 14"
  1111.             CASE 60: FWahl$ = "11, 14"
  1112.             CASE 61: FWahl$ = "11, 12, 14, 15"
  1113.             CASE 62: FWahl$ = "12, 15"
  1114.             CASE 64, 70
  1115.                 FWahl$ = "13, 14, 15"
  1116.             CASE 65: FWahl$ = "13"
  1117.             CASE 66: FWahl$ = "13, 14"
  1118.             CASE 67: FWahl$ = "14"
  1119.             CASE 68: FWahl$ = "14, 15"
  1120.             CASE 69: FWahl$ = "15"
  1121.             CASE 71, 77
  1122.                 FWahl$ = "13 - 18"
  1123.             CASE 72: FWahl$ = "13, 16"
  1124.             CASE 73: FWahl$ = "13, 14, 16, 17"
  1125.             CASE 74: FWahl$ = "14, 17"
  1126.             CASE 75: FWahl$ = "14, 15, 17, 18"
  1127.             CASE 76: FWahl$ = "15, 18"
  1128.             CASE 78, 84
  1129.                 FWahl$ = "16, 17, 18"
  1130.             CASE 79: FWahl$ = "16"
  1131.             CASE 80: FWahl$ = "16, 17"
  1132.             CASE 81: FWahl$ = "17"
  1133.             CASE 82: FWahl$ = "17, 18"
  1134.             CASE 83: FWahl$ = "18"
  1135.             CASE 85, 91
  1136.                 FWahl$ = "16 - 21"
  1137.             CASE 86: FWahl$ = "16, 19"
  1138.             CASE 87: FWahl$ = "16, 17, 19, 20"
  1139.             CASE 88: FWahl$ = "17, 20"
  1140.             CASE 89: FWahl$ = "17, 18, 20, 21"
  1141.             CASE 90: FWahl$ = "18, 21"
  1142.             CASE 92, 98
  1143.                 FWahl$ = "19, 20, 21"
  1144.             CASE 93: FWahl$ = "19"
  1145.             CASE 94: FWahl$ = "19, 20"
  1146.             CASE 95: FWahl$ = "20"
  1147.             CASE 96: FWahl$ = "20, 21"
  1148.             CASE 97: FWahl$ = "21"
  1149.             CASE 99, 105
  1150.                 FWahl$ = "19 - 24"
  1151.             CASE 100: FWahl$ = "19, 22"
  1152.             CASE 101: FWahl$ = "19, 20, 22, 23"
  1153.             CASE 102: FWahl$ = "20, 23"
  1154.             CASE 103: FWahl$ = "20, 21, 23, 24"
  1155.             CASE 104: FWahl$ = "21, 24"
  1156.             CASE 106, 112
  1157.                 FWahl$ = "22, 23, 24"
  1158.             CASE 107: FWahl$ = "22"
  1159.             CASE 108: FWahl$ = "22, 23"
  1160.             CASE 109: FWahl$ = "23"
  1161.             CASE 110: FWahl$ = "23, 24"
  1162.             CASE 111: FWahl$ = "24"
  1163.             CASE 113, 119
  1164.                 FWahl$ = "22 - 27"
  1165.             CASE 114: FWahl$ = "22, 25"
  1166.             CASE 115: FWahl$ = "22, 23, 25, 26"
  1167.             CASE 116: FWahl$ = "23, 26"
  1168.             CASE 117: FWahl$ = "23, 24, 26, 27"
  1169.             CASE 118: FWahl$ = "24, 27"
  1170.             CASE 120, 126
  1171.                 FWahl$ = "25, 26, 27"
  1172.             CASE 121: FWahl$ = "25"
  1173.             CASE 122: FWahl$ = "25, 26"
  1174.             CASE 123: FWahl$ = "26"
  1175.             CASE 124: FWahl$ = "26, 27"
  1176.             CASE 125: FWahl$ = "27"
  1177.             CASE 127, 133
  1178.                 FWahl$ = "25 - 30"
  1179.             CASE 128: FWahl$ = "25, 28"
  1180.             CASE 129: FWahl$ = "25, 26, 28, 29"
  1181.             CASE 130: FWahl$ = "26, 29"
  1182.             CASE 131: FWahl$ = "26, 27, 29, 30"
  1183.             CASE 132: FWahl$ = "27, 30"
  1184.             CASE 134, 140
  1185.                 FWahl$ = "28, 29, 30"
  1186.             CASE 135: FWahl$ = "28"
  1187.             CASE 136: FWahl$ = "28, 29"
  1188.             CASE 137: FWahl$ = "29"
  1189.             CASE 138: FWahl$ = "29, 30"
  1190.             CASE 139: FWahl$ = "30"
  1191.             CASE 141, 147
  1192.                 FWahl$ = "28 - 33"
  1193.             CASE 142: FWahl$ = "28, 31"
  1194.             CASE 143: FWahl$ = "28, 29, 31, 32"
  1195.             CASE 144: FWahl$ = "29, 32"
  1196.             CASE 145: FWahl$ = "29, 30, 32, 33"
  1197.             CASE 146: FWahl$ = "30, 33"
  1198.             CASE 148, 154
  1199.                 FWahl$ = "31, 32, 33"
  1200.             CASE 149: FWahl$ = "31"
  1201.             CASE 150: FWahl$ = "31, 32"
  1202.             CASE 151: FWahl$ = "32"
  1203.             CASE 152: FWahl$ = "32, 33"
  1204.             CASE 153: FWahl$ = "33"
  1205.             CASE 155, 161
  1206.                 FWahl$ = "31 - 36"
  1207.             CASE 156: FWahl$ = "31, 34"
  1208.             CASE 157: FWahl$ = "31, 32, 34, 35"
  1209.             CASE 158: FWahl$ = "32, 35"
  1210.             CASE 159: FWahl$ = "32, 33, 35, 36"
  1211.             CASE 160: FWahl$ = "33, 36"
  1212.             CASE 162, 168
  1213.                 FWahl$ = "34, 35, 36"
  1214.             CASE 163: FWahl$ = "34"
  1215.             CASE 164: FWahl$ = "34, 35"
  1216.             CASE 165: FWahl$ = "35"
  1217.             CASE 166: FWahl$ = "35, 36"
  1218.             CASE 167: FWahl$ = "36"
  1219.         END SELECT
  1220.     CASE ELSE
  1221.         LOCATE 16, 1
  1222.         PRINT "Unbekannte Wahl! FeldNr = "; FeldNr%
  1223.         EXIT FUNCTION
  1224. END SELECT
  1225. END FUNCTION
  1226.  
  1227. '***************************************************************************
  1228. '* Infeld%                                                                 *
  1229. '* Function zur Zuordnung der Mauskoordinaten zu einer Feldnummer          *
  1230. '* Stand: 20.06.94                                                         *
  1231. '***************************************************************************
  1232. '
  1233. 'Ergebnis des Funktionsaufrufs: Feldnummer des gewählten Felds
  1234. '
  1235. 'Aufruf durch:      FEinsatz, FGameNew, FGetWahl, FTaste
  1236. '
  1237. 'Ruft auf:          -
  1238. '
  1239. 'Parameters:    xk%         x-Wert der Mausposition
  1240. '               yk%         y-Wert der Mausposition
  1241. '               af          Variable vom Typ Feld mit der Beschreibung der Lage
  1242. '                           der Felder, der Abstände und der Anzahl
  1243. '
  1244. '
  1245. FUNCTION Infeld% (xk%, yk%, af AS Feld)
  1246.  
  1247. FOR j% = 1 TO af.n
  1248.     IF yk% > af.y + (j% - 1) * af.dy AND yk% < af.y + j% * af.dy THEN
  1249.         FOR i% = 1 TO af.m
  1250.             IF xk% > af.x + (i% - 1) * af.dx AND xk% < af.x + i% * af.dx THEN
  1251.                 Infeld% = i% + (j% - 1) * af.m
  1252.                 EXIT FUNCTION
  1253.             END IF
  1254.         NEXT i%
  1255.     END IF
  1256. NEXT j%
  1257.  
  1258. END FUNCTION
  1259.  
  1260. '***************************************************************************
  1261. '* MouseAction                                                             *
  1262. '* Subprogramm zur Ermittlung der Mauskoordinaten bei linker Taste betätigt*
  1263. '* Stand: 09.07.94                                                         *
  1264. '***************************************************************************
  1265. '
  1266. 'Ermittelt Mauskoordinaten bei linker Maustaste betätigt und gibt
  1267. 'Koordinaten am Bildschirm aus
  1268. '
  1269. 'Aufruf durch:      FGameNew, Setzen
  1270. '
  1271. 'Ruft auf:          MousePressLeft
  1272. '
  1273. 'Parameters:    xm1%, ym1%      Rückgabeparameter, Mauskoordinaten
  1274. '
  1275. '
  1276. SUB MouseAction (xm1%, ym1%)
  1277.     DO
  1278.         MousePressLeft leftcount%, xm1%, ym1%
  1279.         IF leftcount% <> 0 THEN
  1280.             curx% = POS(0): cury% = CSRLIN
  1281.             LOCATE 57, 1
  1282.             PRINT "x-Pos. = "; xm1%
  1283.             PRINT "y-Pos. = "; ym1%
  1284.             LOCATE cury%, curx%
  1285.         END IF
  1286.     LOOP UNTIL leftcount% <> 0
  1287. END SUB
  1288.  
  1289.   ' ************************************************
  1290.   ' **  Name:          MouseHide                  **
  1291.   ' **  Type:          Subprogram                 **
  1292.   ' **  Module:        MOUSSUBS.BAS               **
  1293.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  1294.   ' ************************************************
  1295.   '
  1296.   ' Hides the mouse cursor.
  1297.   '
  1298.   ' EXAMPLE OF USE:  MouseHide
  1299.   '
  1300.   ' Aufruf durch:   ROULET.BAS, FehlMeld, FGameNew
  1301.   '
  1302.   ' Ruft auf:       Mouse (QLB)
  1303.   '
  1304.   ' PARAMETERS:      (none)
  1305.   ' VARIABLES:       (none)
  1306.   ' MODULE LEVEL
  1307.   '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
  1308.   '                  DECLARE SUB MouseHide ()
  1309.   '
  1310.     SUB MouseHide STATIC
  1311.         Mouse 2, 0, 0, 0
  1312.     END SUB
  1313.  
  1314.   ' ************************************************
  1315.   ' **  Name:          MouseInches                **
  1316.   ' **  Type:          Subprogram                 **
  1317.   ' **  Module:        MOUSSUBS.BAS               **
  1318.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  1319.   ' ************************************************
  1320.   '
  1321.   ' Sets mouse motion ratio in inches per screen.
  1322.   '
  1323.   ' EXAMPLE OF USE:  MouseInches horizontal%, vertical%
  1324.   '
  1325.   ' Aufruf durch:   -
  1326.   '
  1327.   ' Ruft auf:       Mouse (QLB)
  1328.   '
  1329.   ' PARAMETERS:      horizontal%   Inches of horizontal mouse motion per
  1330.   '                                screen width
  1331.   '                  vertical%     Inches of vertical% mouse motion per
  1332.   '                                screen height
  1333.   ' VARIABLES:       h%            Calculated value to pass to mouse driver
  1334.   '                  v%            Calculated value to pass to mouse driver
  1335.   ' MODULE LEVEL
  1336.   '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
  1337.   '                  DECLARE SUB MouseInches (horizontal%, vertical%)
  1338.   '
  1339.     SUB MouseInches (horizontal%, vertical%) STATIC
  1340.         IF horizontal% > 100 THEN
  1341.             horizontal% = 100
  1342.         END IF
  1343.         IF vertical% > 100 THEN
  1344.             vertical% = 100
  1345.         END IF
  1346.         h% = horizontal% * 5 \ 2
  1347.         v% = vertical% * 8
  1348.         Mouse 15, 0, h%, v%
  1349.     END SUB
  1350.  
  1351.   ' ************************************************
  1352.   ' **  Name:          MouseInstall               **
  1353.   ' **  Type:          Subprogram                 **
  1354.   ' **  Module:        MOUSSUBS.BAS               **
  1355.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  1356.   ' ************************************************
  1357.   '
  1358.   ' Determines whether mouse is available and resets all mouse parameters.
  1359.   '
  1360.   ' EXAMPLE OF USE:  MouseInstall mflag%
  1361.   '
  1362.   ' Aufruf durch:   ROULET.BAS
  1363.   '
  1364.   ' Ruft auf:       Mouse (QLB)
  1365.   '
  1366.   ' PARAMETERS:      mflag%     Returned indication of mouse availability
  1367.   ' VARIABLES:       (none)
  1368.   ' MODULE LEVEL
  1369.   '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
  1370.   '                  DECLARE SUB MouseInstall (mflag%)
  1371.   '
  1372.     SUB MouseInstall (mflag%) STATIC
  1373.         mflag% = 0
  1374.         Mouse mflag%, 0, 0, 0
  1375.     END SUB
  1376.  
  1377.   ' ************************************************
  1378.   ' **  Name:          MousePressLeft             **
  1379.   ' **  Type:          Subprogram                 **
  1380.   ' **  Module:        MOUSSUBS.BAS               **
  1381.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  1382.   ' ************************************************
  1383.   '
  1384.   ' Returns the mouse state at last press of left button.
  1385.   '
  1386.   ' EXAMPLE OF USE:  MousePressLeft leftCount%, xMouse%, yMouse%
  1387.   '
  1388.   ' Aufruf durch:   MouseAction
  1389.   '
  1390.   ' Ruft auf:       Mouse (QLB)
  1391.   '
  1392.   ' PARAMETERS:      leftCount%    Number of times the left button has been
  1393.   '                                pressed since the last call to this
  1394.   '                                subprogram
  1395.   '                  xMouse%       X location of the mouse at the last press
  1396.   '                                of the left button
  1397.   '                  yMouse%       Y location of the mouse at the last press
  1398.   '                                of the left button
  1399.   ' VARIABLES:       m1%           Parameter for call to mouse driver
  1400.   ' MODULE LEVEL
  1401.   '   DECLARATIONS:    DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
  1402.   '                    DECLARE SUB MousePressLeft (leftCount%, xMouse%, yMouse%)
  1403.   '
  1404.     SUB MousePressLeft (leftcount%, xMouse%, yMouse%) STATIC
  1405.         m1% = 5
  1406.         leftcount% = 0
  1407.         Mouse m1%, leftcount%, xMouse%, yMouse%
  1408.     END SUB
  1409.  
  1410.   ' ************************************************
  1411.   ' **  Name:          MousePut                   **
  1412.   ' **  Type:          Subprogram                 **
  1413.   ' **  Module:        MOUSSUBS.BAS               **
  1414.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  1415.   ' ************************************************
  1416.   '
  1417.   ' Sets the mouse position.
  1418.   '
  1419.   ' EXAMPLE OF USE:  MousePut xMouse%, yMouse%
  1420.   '
  1421.   ' Aufruf durch:   -
  1422.   '
  1423.   ' Ruft auf:       Mouse (QLB)
  1424.   '
  1425.   ' PARAMETERS:      xMouse%    Horizontal location to place cursor
  1426.   '                  yMouse%    Vertical location to place cursor
  1427.   ' VARIABLES:       (none)
  1428.   ' MODULE LEVEL
  1429.   '   DECLARATIONS:   DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
  1430.   '                   DECLARE SUB MousePut (xMouse%, yMouse%)
  1431.   '
  1432.     SUB MousePut (xMouse%, yMouse%) STATIC
  1433.         Mouse 4, 0, xMouse%, yMouse%
  1434.     END SUB
  1435.  
  1436.   ' ************************************************
  1437.   ' **  Name:          MouseReleaseLeft           **
  1438.   ' **  Type:          Subprogram                 **
  1439.   ' **  Module:        MOUSSUBS.BAS               **
  1440.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  1441.   ' ************************************************
  1442.   '
  1443.   ' Returns the mouse state at last release of left button.
  1444.   '
  1445.   ' EXAMPLE OF USE:  MouseReleaseLeft leftCount%, xMouse%, yMouse%
  1446.   '
  1447.   ' Aufruf durch:   -
  1448.   '
  1449.   ' Ruft auf:       Mouse (QLB)
  1450.   '
  1451.   ' PARAMETERS:      leftCount%    Number of times the left button has been
  1452.   '                                released since the last call to this
  1453.   '                                subprogram
  1454.   '                  xMouse%       X location of the mouse at the last
  1455.   '                                release of the left button
  1456.   '                  yMouse%       Y location of the mouse at the last
  1457.   '                                release of the left button
  1458.   ' VARIABLES:       m1%           Parameter for call to mouse driver
  1459.   ' MODULE LEVEL
  1460.   '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
  1461.   '                  DECLARE SUB MouseReleaseLeft (leftCount%, xMouse%,
  1462.   '                                               yMouse%)
  1463.   '
  1464.     SUB MouseReleaseLeft (leftcount%, xMouse%, yMouse%) STATIC
  1465.         m1% = 6
  1466.         leftcount% = 0
  1467.         Mouse m1%, leftcount%, xMouse%, yMouse%
  1468.     END SUB
  1469.  
  1470.   ' ************************************************
  1471.   ' **  Name:          MouseShow                  **
  1472.   ' **  Type:          Subprogram                 **
  1473.   ' **  Module:        MOUSSUBS.BAS               **
  1474.   ' **  Language:      Microsoft QuickBASIC 4.00  **
  1475.   ' ************************************************
  1476.   '
  1477.   ' Shows the mouse cursor.
  1478.   '
  1479.   ' EXAMPLE OF USE:  MouseShow
  1480.   '
  1481.   ' Aufruf durch:   ROULET.BAS, FehlMeld, FGameNew, Setzen
  1482.   '
  1483.   ' Ruft auf:       Mouse (QLB)
  1484.   '
  1485.   ' PARAMETERS:      (none)
  1486.   ' VARIABLES:       (none)
  1487.   ' MODULE LEVEL
  1488.   '   DECLARATIONS:  DECLARE SUB Mouse (m1%, m2%, m3%, m4%)
  1489.   '                  DECLARE SUB MouseShow ()
  1490.   '
  1491.     SUB MouseShow STATIC
  1492.         Mouse 1, 0, 0, 0
  1493.     END SUB
  1494.  
  1495. '***************************************************************************
  1496. '* Setzen                                                                  *
  1497. '* Subprogramm zur Abfrage der Einsätze Chip + Nummer                      *
  1498. '* Stand: 18.09.94                                                         *
  1499. '***************************************************************************
  1500. '
  1501. 'Ermittelt die Spieleinsätze
  1502. '
  1503. 'Aufruf durch:      ROULET.BAS
  1504. '
  1505. 'Ruft auf:          EinsEintr, FGetWahl, FehlMeld, FEinsatz, FWahl,
  1506. '                   FTaste, MouseAction, MouseShow
  1507. '
  1508. '
  1509. ' Parameters:       spieler$        String mit Spielernamen
  1510. '                   spnr%           Spielernummer
  1511. '
  1512. SUB Setzen (spieler$, spnr%)
  1513.  
  1514. COLOR 14
  1515. PRINT
  1516. PRINT "Spieleinsatz für "; spieler$
  1517. PRINT
  1518.  
  1519. 'Aufruf des Mauscursors
  1520.  
  1521. MouseShow
  1522.  
  1523. FOR k% = 1 TO 3
  1524.     zeile% = CSRLIN: spalte% = POS(0)
  1525.  
  1526.     '************** Ermittlung des gewählten Chips
  1527. beginn:
  1528.     xb% = 32
  1529.     yb% = 240
  1530.     LINE (xb%, yb%)-(xb% + 100, yb% + 36), 15, B
  1531.     bzeile% = 33: bspalte% = 6
  1532.     LOCATE bzeile%, bspalte%
  1533.     COLOR 14
  1534.     PRINT "Chip wählen"
  1535.     MouseAction xm1%, ym1%
  1536.    
  1537.     '****************** Funktionstasten abfragen
  1538.    
  1539.     Taste% = FTaste%(xm1%, ym1%)        'Funktionsaufruf zur Ermittlung der gew. Taste
  1540.  
  1541.     IF Taste% = 3 THEN                  'fertig
  1542.         LOCATE bzeile% - 2, bspalte% - 2
  1543.         FOR i% = 1 TO 5
  1544.             PRINT SPACE$(20)            'Löschen der Anweisungsbox
  1545.         NEXT i%
  1546.         LOCATE zeile%, spalte%
  1547.         EXIT FOR
  1548.     END IF
  1549.   
  1550.     IF Taste% = 1 AND k% > 1 THEN       'löschen des letzten Eintrages
  1551.         zeile% = zeile% - 2
  1552.         LOCATE zeile%, spalte%
  1553.         PRINT SPACE$(30)
  1554.         zeile% = CSRLIN - 1
  1555.         LOCATE zeile%, spalte%
  1556.         k% = k% - 1
  1557.         IF spnr% = 1 THEN
  1558.             IF k% = 1 THEN
  1559.                 speins(1, 1).akt = 0
  1560.             ELSEIF k% = 2 THEN
  1561.                 speins(1, 2).akt = 0
  1562.             ELSE                ' k% = 3
  1563.                 speins(1, 3).akt = 0
  1564.             END IF
  1565.         ELSEIF spnr% = 2 THEN
  1566.             IF k% = 1 THEN
  1567.                 speins(2, 1).akt = 0
  1568.             ELSEIF k% = 2 THEN
  1569.                 speins(2, 2).akt = 0
  1570.             ELSE                    ' k% = 3
  1571.                 speins(2, 3).akt = 0
  1572.             END IF
  1573.         ELSE
  1574.             PRINT "Falsche Spielernummer!"
  1575.         END IF
  1576.     GOTO beginn
  1577.     END IF
  1578.    
  1579.     einsatz# = FEinsatz#(xm1%, ym1%)         'Funktionsaufruf
  1580.     IF einsatz# = 0 THEN
  1581.         FehlNr% = 1
  1582.         FehlMeld FehlNr%
  1583.         GOTO beginn
  1584.     END IF
  1585.    
  1586.     'Überprüfung auf Kontoüberziehung
  1587.  
  1588.     IF spnr% = 1 THEN
  1589.         sp1# = sp1# - einsatz#
  1590.         IF sp1# < 0 THEN
  1591.             'Kontoüberziehung, Einsatz wird nicht angenommen
  1592.             sp1# = sp1# + einsatz#
  1593.             FehlNr% = 3
  1594.             FehlMeld FehlNr%
  1595.             GOTO beginn
  1596.         END IF
  1597.     ELSE
  1598.         sp2# = sp2# - einsatz#
  1599.         IF sp2# < 0 THEN
  1600.             'Kontoüberziehung, Einsatz wird nicht angenommen
  1601.             sp2# = sp2# + einsatz#
  1602.             FehlNr% = 3
  1603.             FehlMeld FehlNr%
  1604.             GOTO beginn
  1605.         END IF
  1606.     END IF
  1607.    
  1608.     LOCATE bzeile%, bspalte%
  1609.     PRINT "Feld wählen"
  1610.    
  1611.     '****************** Ermittlung der gewählten Ziffer
  1612.    
  1613.     MouseAction xm1%, ym1%
  1614.     wahl% = FGetWahl%(xm1%, ym1%)   'Funktionsaufruf zur Ermittlung der
  1615.                                     'symbolischen Feldnummer der
  1616.                                     'gew. Ziffer oder des gew. Feldes
  1617.    
  1618.     IF wahl% = 888 THEN             'Falscheingabe
  1619.         FehlNr% = 2
  1620.         FehlMeld FehlNr%
  1621.         GOTO beginn
  1622.     END IF
  1623.  
  1624.     LOCATE 35, 4
  1625.     PRINT SPACE$(30)
  1626.     LOCATE zeile%, spalte%
  1627.     COLOR 14
  1628.     PRINT "DM "; einsatz#; " auf "; FWahl$(wahl%)
  1629.     PRINT
  1630.     zeile% = CSRLIN: spalte% = POS(0)
  1631.  
  1632.     '****************** Eintragung des Einsatzes
  1633.  
  1634.     EinsEintr spnr%, k%, einsatz#, wahl%
  1635.    
  1636.     cureins# = cureins# + einsatz#
  1637. NEXT k%
  1638. LOCATE bzeile% - 2, bspalte% - 2
  1639. FOR i% = 1 TO 5
  1640.     PRINT SPACE$(20)            'Löschen der Anweisungsbox
  1641. NEXT i%
  1642. LOCATE zeile%, spalte%
  1643. END SUB
  1644.  
  1645. '***************************************************************************
  1646. '* Spielfeld                                                               *
  1647. '* Subprogramm zum Aufbau des Roulettespielfelds                           *
  1648. '* Stand: 03.07.94                                                         *
  1649. '***************************************************************************
  1650. '
  1651. 'Aufruf durch:      ROULET.BAS
  1652. '
  1653. 'Ruft auf:          -
  1654. '
  1655. ' Variables:    x1%         x-Koord. linke, obere Ecke des Setzfeldes bei Null
  1656. '               y1%         y-Koord.  wie oben
  1657. '               dx1%        Spaltenabstand des Setzfeldes
  1658. '               dy1%        Zeilenabstand des Setzfeldes
  1659. '               xch%        x-Koord. des 5 DM Chips
  1660. '               ych%        y-Koord. des 5 DM Chips
  1661. '               dxch%       x-Abstand der Chips
  1662. '               dych%       y-Abstand der Chips
  1663. '               rch%        Radius der Chips
  1664. '               xf%         x-Koord. der ersten Funktionstaste
  1665. '               yf%         y-Koord. der ersten Funktionstaste
  1666. '               dxf%        Abstand der Funktionstasten in x
  1667. '               lxf%        Funktionstastenlänge
  1668. '               lyf%        Funktionstastenbreite
  1669. '
  1670. '
  1671. SUB Spielfeld STATIC
  1672.  
  1673. WIDTH 80, 60
  1674. PALETTE 0, 7680     'grüner Hintergrund
  1675. CLS
  1676.  
  1677.  
  1678. '****** Zeichnen des Roulette-Setzfeldes
  1679.  
  1680. 'Felder 0 - 36
  1681. x1% = 388       'Obere linke Ecke bei Null
  1682. y1% = 12
  1683. dx1% = 40
  1684. dy1% = 32
  1685.  
  1686. 'waagrechte Linien
  1687. LINE (x1%, y1%)-(x1% + 3 * dx1%, y1%)
  1688. FOR i% = 1 TO 14
  1689.     LINE (x1%, y1% + i% * dy1%)-(x1% + 3 * dx1%, y1% + i% * dy1%)
  1690. NEXT i%
  1691.  
  1692. 'senkrechte Linien
  1693. FOR i% = 0 TO 3
  1694.     LINE (x1% + i% * dx1%, y1% + dy1%)-(x1% + i% * dx1%, y1% + 14 * dy1%)
  1695. NEXT i%
  1696.  
  1697. 'Senkrechte bei Null
  1698. LINE (x1%, y1%)-(x1%, y1% + dy1%)
  1699. LINE (x1% + 3 * dx1%, y1%)-(x1% + 3 * dx1%, y1% + dy1%)
  1700.  
  1701. 'Beschriftung der Nummernfelder
  1702.  
  1703. LOCATE 4, 57
  1704. PRINT "0"
  1705. PALETTE 8, 0                            'color 8 = schwarz
  1706. n% = 1                                  'erste Zahl
  1707. FOR j% = 8 TO 52 STEP 4
  1708.     FOR i% = 51 TO 61 STEP 5
  1709.         LOCATE j%, i%
  1710.        
  1711.         'Farbe ermitteln
  1712.         IF Farbe$(n%) = "r" THEN
  1713.             COLOR 12
  1714.         ELSE
  1715.             COLOR 8
  1716.         END IF
  1717.        
  1718.         'zweistellige Zahl rechtsbündig ausgeben
  1719.         PRINT RIGHT$(STR$(n%), 2)
  1720.        
  1721.         n% = n% + 1                     'nächste Zahl
  1722.     NEXT i%
  1723. NEXT j%
  1724.  
  1725. COLOR 15
  1726.  
  1727. 'Zeichnen der allgemeinen Setzfelder
  1728. 'links
  1729.  
  1730. 'Waagrechte
  1731. FOR i% = 1 TO 13 STEP 4
  1732.     LINE (x1% - 3 * dx1%, y1% + i% * dy1%)-(x1%, y1% + i% * dy1%)
  1733. NEXT i%
  1734. LINE (x1% - 3 * dx1%, y1% + 14 * dy1%)-(x1%, y1% + 14 * dy1%)
  1735.  
  1736. 'Senkrechte
  1737. LINE (x1% - 3 * dx1%, y1% + dy1%)-(x1% - 3 * dx1%, y1% + 14 * dy1%)
  1738. LINE (x1% - 2 * dx1%, y1% + 13 * dy1%)-(x1% - 2 * dx1%, y1% + 14 * dy1%)
  1739. LINE (x1% - dx1%, y1% + 13 * dy1%)-(x1% - dx1%, y1% + 14 * dy1%)
  1740.  
  1741.  
  1742. 'rechts
  1743. 'Waagrechte
  1744. FOR i% = 1 TO 13 STEP 4
  1745.     LINE (x1% + 3 * dx1%, y1% + i% * dy1%)-(x1% + 6 * dx1%, y1% + i% * dy1%)
  1746. NEXT i%
  1747. LINE (x1% + 3 * dx1%, y1% + 14 * dy1%)-(x1% + 6 * dx1%, y1% + 14 * dy1%)
  1748.  
  1749. 'Senkrechte
  1750. LINE (x1% + 6 * dx1%, y1% + dy1%)-(x1% + 6 * dx1%, y1% + 14 * dy1%)
  1751. LINE (x1% + 4 * dx1%, y1% + 13 * dy1%)-(x1% + 4 * dx1%, y1% + 14 * dy1%)
  1752. LINE (x1% + 5 * dx1%, y1% + 13 * dy1%)-(x1% + 5 * dx1%, y1% + 14 * dy1%)
  1753.                                           
  1754. 'schwarze Raute
  1755. LINE (x1% - 2 * dx1%, y1% + 11 * dy1%)-(x1% - 1.5 * dx1%, y1% + 10 * dy1%)
  1756. LINE (x1% - dx1%, y1% + 11 * dy1%)-(x1% - 1.5 * dx1%, y1% + 10 * dy1%)
  1757. LINE (x1% - 2 * dx1%, y1% + 11 * dy1%)-(x1% - 1.5 * dx1%, y1% + 12 * dy1%)
  1758. LINE (x1% - dx1%, y1% + 11 * dy1%)-(x1% - 1.5 * dx1%, y1% + 12 * dy1%)
  1759. PALETTE 8, 0                'Farbattribut 8 = schwarz !!
  1760. PAINT (x1% - 1.5 * dx1%, y1% + 11 * dy1%), 8, 15
  1761.  
  1762. 'rote Raute
  1763. LINE (x1% + 4 * dx1%, y1% + 11 * dy1%)-(x1% + 4.5 * dx1%, y1% + 10 * dy1%)
  1764. LINE (x1% + 5 * dx1%, y1% + 11 * dy1%)-(x1% + 4.5 * dx1%, y1% + 10 * dy1%)
  1765. LINE (x1% + 4 * dx1%, y1% + 11 * dy1%)-(x1% + 4.5 * dx1%, y1% + 12 * dy1%)
  1766. LINE (x1% + 5 * dx1%, y1% + 11 * dy1%)-(x1% + 4.5 * dx1%, y1% + 12 * dy1%)
  1767. PAINT (x1% + 4.5 * dx1%, y1% + 11 * dy1%), 4, 15
  1768.  
  1769. 'Beschriftung der allgemeinen Setzfelder
  1770.  
  1771. LOCATE 14, 40
  1772. PRINT "PASSE"
  1773. LOCATE 30, 40
  1774. PRINT "PAIR"
  1775.  
  1776. LOCATE 14, 69
  1777. PRINT "MANQUE"
  1778. LOCATE 30, 69
  1779. PRINT "IMPAIR"
  1780.  
  1781.  
  1782. 'links
  1783. LOCATE 56, 35
  1784. PRINT "1.D."
  1785. LOCATE 56, 40
  1786. PRINT "2.D."
  1787. LOCATE 56, 45
  1788. PRINT "3.D."
  1789.  
  1790. 'rechts
  1791. LOCATE 56, 75
  1792. PRINT "1.D."
  1793. LOCATE 56, 70
  1794. PRINT "2.D."
  1795. LOCATE 56, 65
  1796. PRINT "3.D."
  1797.  
  1798. '***************************** Chips zeichnen *****************************
  1799.  
  1800. xch% = 26
  1801. ych% = 316  'war 356
  1802. dxch% = 55
  1803. dych% = 55
  1804. rch% = 20
  1805.  
  1806. CIRCLE (xch%, ych%), rch%
  1807. PAINT (xch%, ych%), 1, 15
  1808. CIRCLE (xch% + dxch%, ych%), rch%
  1809. PAINT (xch% + dxch%, ych%), 3, 15
  1810. CIRCLE (xch% + 2 * dxch%, ych%), rch%
  1811. PAINT (xch% + 2 * dxch%, ych%), 4, 15
  1812. CIRCLE (xch% + 3 * dxch%, ych%), rch%
  1813. PAINT (xch% + 3 * dxch%, ych%), 5, 15
  1814. CIRCLE (xch%, ych% + dych%), rch%
  1815. PAINT (xch%, ych% + dych%), 9, 15
  1816. CIRCLE (xch% + dxch%, ych% + dych%), rch%
  1817. PAINT (xch% + dxch%, ych% + dych%), 10, 15
  1818. CIRCLE (xch% + 2 * dxch%, ych% + dych%), rch%
  1819. PAINT (xch% + 2 * dxch%, ych% + dych%), 11, 15
  1820. CIRCLE (xch% + 3 * dxch%, ych% + dych%), rch%
  1821. PAINT (xch% + 3 * dxch%, ych% + dych%), 12, 15
  1822.  
  1823. 'Chips beschriften
  1824.  
  1825. LOCATE 40, 4
  1826. PRINT "5"
  1827. LOCATE 40, 10
  1828. PRINT "10"
  1829. LOCATE 40, 17
  1830. PRINT "20"
  1831. LOCATE 40, 24
  1832. PRINT "50"
  1833. LOCATE 47, 3
  1834. PRINT "100"
  1835. LOCATE 47, 10
  1836. PRINT "200"
  1837. LOCATE 47, 17
  1838. PRINT "500"
  1839. LOCATE 47, 23
  1840. PRINT "1000"
  1841.  
  1842. '********************** Funktionstasten zeichnen ***************************
  1843.  
  1844. xf% = 6
  1845. yf% = 412
  1846. dxf% = 78
  1847. lxf% = 64
  1848. lyf% = 30
  1849. PALETTE 7, 2555959
  1850. 'COLOR 9
  1851. FOR i% = 0 TO 2
  1852.     LINE (xf% + i% * dxf%, yf%)-(xf% + lxf% + i% * dxf%, yf% + lyf%), 15, B
  1853.     PAINT (xf% + lxf% / 2 + i% * dxf%, yf% + lyf% / 2), 7, 15
  1854. NEXT i%
  1855.  
  1856. COLOR 15
  1857. LOCATE 54, 2
  1858. PRINT "löschen"
  1859. LOCATE 54, 14
  1860. PRINT "O.K."
  1861. LOCATE 54, 22
  1862. PRINT "fertig"
  1863.  
  1864. END SUB
  1865.  
  1866.